;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; File    : engine.scm
;; Version : 0.1
;; Author  : Harish Sharma
;; Date    : 11th May 2007
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; single checkers
(define _dark 2)
(define _lite 3)
;; king checkers
(define _dark_king 4)
(define _lite_king 9)
;; cell types
(define _empty 1)
(define _invalid 0)
;; game state
(define _turn  _lite)
(define _rival _dark)
(define _self  _lite)

(define _max_depth 8) ;; max depth to search to
(define _max_time 60) ;; max search time in seconds

(define _moves     (make-vector 256))   ;; these are actual moves that are played by players
(define _gen_moves (make-vector 512))   ;; enough space to store 512 moves while searching
(define _scores    (make-vector 512))   ;; enough space to store scores for 512 moves
(define _pv_moves  (make-vector 32))    ;; won't need to search beyond ply 32
;;
;; checkered board
;; 0 value cells are invalid for making any moves
;; 1 value cells are valid for making moves
;; 2 value cells are dark checkers
;; 3 value cells are lite checkers
;; 4 value cells are king dark checkers
;; 9 value cells are king lite checkers
;;
(define _board (l2v   '(0 0 0 0 0 0 0 0 0 0    ;;  0-9
                        0 0 2 0 2 0 2 0 2 0    ;; 10-19
                        0 2 0 2 0 2 0 2 0 0    ;; 20-29
                        0 0 2 0 2 0 2 0 2 0    ;; 30-39
                        0 1 0 1 0 1 0 1 0 0    ;; 40-49
                        0 0 1 0 1 0 1 0 1 0    ;; 50-59
                        0 3 0 3 0 3 0 3 0 0    ;; 60-69
                        0 0 3 0 3 0 3 0 3 0    ;; 70-79
                        0 3 0 3 0 3 0 3 0 0    ;; 80-89
                        0 0 0 0 0 0 0 0 0 0))) ;; 90-99

;; vector of valid cells on the board, just so that 
;; the evaluation function does not need to  
(define _valid_cells '(12 14 16 18 
						  21 23 25 27 
						  32 34 36 38 
						  41 43 45 47 
						  52 54 56 58
						  61 63 65 67
						  72 74 76 78
						  81 83 85 87)))

;; move directions
(define _offsets (l2v '(-22 -18 -11 -9 22 18 11 9)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : gets the stepped over cell content (type)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (stepped-over-checker color from to)
  (let ((diff (- to from)))
    (vref _board (+ (to (/ diff 2))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : gets the stepped over cell ordinate
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (stepped-over-cell from to)
  (let ((diff (- to from)))
    (+ (to (/ diff 2)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : draws the board
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (draw-board)
  ;; translates the board content to appropriate character for printing
  (define (translate val)
    (cond ((= val _dark) #\O)
          ((= val _lite) #\X)
          ((= val _dark_king) #\@)
          ((= val _lite_king) #\#)
          (else #\.)))

  (define line "\n--+-----------------+")
  (printf "\n0 | 1 2 3 4 5 6 7 8 |~a" line)

  (let traverse ((i 10))
	(let ((r (% i 10)))
	  (cond ((> i 89) 
			 '()) ;; terminal condition
			((= 9 r) 
			 (printf " ~a" "|")
			 (traverse (+ i 1))) 
			((= 0 r) 
			 (printf "\n~a ~a" (/ i 10) "|") 
			 (traverse (+ i 1)))
			(else 
			 (printf " ~a" (translate (vref _board i))) 
			 (traverse (+ i 1))))))
	(display line))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : validates if a move path is correct
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (valid-move? move-path)
  ;;
  ;; this function validates individual from, to pair
  ;;
  (define (move? pctype from to next)
    (call/cc 
	 (lambda (return) 
	   (let ((to_contains (vref _board to)))
		 (cond ((not (= _empty to_contains)) 
				(return #f))  
		       ((= pctype _lite) 
				(if (>= to from) 
					(return #f))) 
		       ((= pctype _dark) 
				(if (<= to from) 
					(return #f))) 
		       (else 
				(let ((diff (abs (- to from))))
				  (cond ((or (= diff 11) (= diff 9)) ;; single step in diagonal direction
						 ;; if the remaining path is null? this move is valid
						 (null? next)) 
						;; a jump move ...
						((or (= diff 22) (= diff 18))
						 ;; if the stepped over checker is rival type, this move is valid
						 (= _rival (stepped-over-checker pctype from to)))
						(else #f)))))))))
  ;;
  ;; do some sanity checks and then validate each pair of from, to using move?
  ;;
  (call/cc 
   (lambda (return)
	 (if (> 2 (length move-path)) 
		 (return #f)) 
	 (let ((fr (car move-path)))
	   (if (or (= _empty (vref _board fr)) (= _invalid (vref _board fr))) 
		   (return #f))
	   (if (not (= _turn (vref _board fr))) 
		   (return #f))
	   (let ((pt (vref _board fr))) ;; checker type
		 (let check-moves ((f fr) 
						   (t (cadr move-path)) 
						   (rp (cddr move-path)))
		   (if (move? pt f t rp) 
			   (if (null? rp) 
				   #t 
				   (check-moves t (car rp) (cdr rp)))
			   #f)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : swaps turn and rival 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (swap-turns)
  (let ((t _turn))
    (set! _turn _rival)
    (set! _rival t)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : generates moves for the side to play
;; note : one of the 3 most important functions in a board game engine. The other
;;        2 being static evaluation and move search functions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (generate-moves)
  (define (gen i)
	(let ((pt (vref _board i)))
	  (cond 
	   ((= pt _empty))
	   ((= pt _dark)
		)
	   ((= pt _lite)
		)
	   ((or (= pt _dark_king) (= pt _lite_king))
		)
	   (else
		))))

  (for-each gen _valid_cells) 
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : static evaluation of a game position
;; note : the quality of output of this function will actually determine the 
;;        strength of the game. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (evaluate)
  (printf "evaluate function"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : plays given move on the board and returns a list of captures
;; arg1 : move path list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-move move-path)
  ;; basic sanity checks are avoided due to assumption
  ;; ASSUMPTION: the move-path is already validated
  (call/cc 
   (lambda (return)
	 (let ((color (vref _board (car move-path)))
		   (captures '())) ;; start with an empty capture list
	   (let traverse ((from (car move-path))
					  (to (cadr move-path)) 
					  (next (cddr move-path))) ;; remaining move path
		 (if (null? from) 
			 (return captures))
		 (case (diff (abs (- to from)))
		   ;; whatever color, if the checker is moved only one step then ...
		   ((9 11) 
			(begin 
			  (vset _board to _turn)                   ;; set to cell to _turn color
			  (vset _board from _empty)) (return '())) ;; set 'from' cell to _empty
		   ;; whatever color, if the checker is moved over an existing checker on board ...
		   ((18 22) 
			(begin 
			  (if (= _rival (stepped-over-checker color from to))
				  (begin
					(set! captures (append captures (stepped-over-cell color from to)))
					(vset _board (stepped-over-cell from to) _empty)))
			  (if (not (null? next)) 
				  (traverse (car next) (cadr next) (cddr next))
				  (return captures))))
		   (else
			(error (format "invalid move (~a,~a)" from to)))))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : unmakes the previously played move
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (unmake-move path captures)
  ;; move-path gives the coordinates of moves made
  ;; captures gives the rival checkers captured
  ;; take-back-checker moves the played checker back to its previous position
  (define (move-back moves)
    (let ((from (car moves))
          (to   (last moves)))
      (vset _board from _turn)
      (vset _board to _empty)))
  ;; replace-captures replaces all the captured rival checkers
  (define (replace-captures caps)
    (if (not (null? caps))
        (begin (vset _board (car caps) _rival)
               (replace-captures (cdr caps)))))
  (begin
    (move-back path)
    (if (not (null? captures)) 
        (replace-captures captures))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : thinks to search the next move
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (think)
  (define (think-helper depth)
    (if (>= _max_depth depth)
        (begin (search 1 depth 1000000 -1000000)
               (think-helper (+ depth 1)))))
  (think-helper 1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : alpha-beta search for next move
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (search ply depth alpha beta)
  (printf "search function"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; desc : entry point of the engine
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (play)
  (draw-board)
  (printf "\nplay started"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
